home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2005 October / PCWOCT05.iso / Software / Resources / CutePDF 2.3 / converter.exe / GNUGS / GS_SETPD.PS < prev    next >
Text File  |  2003-04-01  |  25KB  |  777 lines
  1. %    Copyright (C) 1994, 2000 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This software is provided AS-IS with no warranty, either express or
  4. % implied.
  5. % 
  6. % This software is distributed under license and may not be copied,
  7. % modified or distributed except as expressly authorized under the terms
  8. % of the license contained in the file LICENSE in this distribution.
  9. % 
  10. % For more information about licensing, please refer to
  11. % http://www.ghostscript.com/licensing/. For information on
  12. % commercial licensing, go to http://www.artifex.com/licensing/ or
  13. % contact Artifex Software, Inc., 101 Lucas Valley Road #110,
  14. % San Rafael, CA  94903, U.S.A., +1(415)492-9861.
  15.  
  16. % $Id: gs_setpd.ps,v 1.8.2.2.2.1 2003/03/31 13:02:22 giles Exp $
  17. % The current implementation of setpagedevice has the following limitations:
  18. %    - It doesn't attempt to "interact with the user" for Policy = 2.
  19.  
  20. languagelevel 1 .setlanguagelevel
  21. level2dict begin
  22.  
  23. % ---------------- Redefinitions ---------------- %
  24.  
  25. % Redefine .beginpage and .endpage so that they call BeginPage and
  26. % EndPage respectively if appropriate.
  27.  
  28. % We have to guard against the BeginPage procedure not popping its operand.
  29. % This is really stupid, but the Genoa CET does it.
  30. /.beginpage {        % - .beginpage -
  31.   .currentshowpagecount {
  32.     .currentpagedevice pop
  33.     dup null ne { /BeginPage .knownget } { pop false } ifelse {
  34.         % Stack: ... pagecount proc
  35.        count 2 .execn
  36.         % Stack: ... ..???.. oldcount
  37.        count 1 add exch sub { pop } repeat
  38.     } {
  39.       pop
  40.     } ifelse
  41.   } if
  42. } bind odef
  43.  
  44. % Guard similarly against EndPage not popping its operand.
  45. /.endpage {        % <reason> .endpage <print_bool>
  46.   .currentshowpagecount {
  47.     1 index .currentpagedevice pop
  48.     dup null ne { /EndPage .knownget } { pop false } ifelse {
  49.         % Stack: ... reason pagecount reason proc
  50.       count 2 .execn
  51.         % Stack: ... ..???.. print oldcount
  52.       count 2 add exch sub { exch pop } repeat
  53.     } {
  54.       pop pop 2 ne
  55.     } ifelse
  56.   } {
  57.     2 ne
  58.   } ifelse
  59. } bind odef
  60.  
  61. % Define interpreter callouts for handling gstate-saving operators,
  62. % to make sure that they create a page device dictionary for use by
  63. % the corresponding gstate-restoring operator.
  64. % We'd really like to avoid the cost of doing this, but we don't see how.
  65. % The names %gsavepagedevice, %savepagedevice, %gstatepagedevice,
  66. % %copygstatepagedevice, and %currentgstatepagedevice are known to the
  67. % interpreter.
  68.  
  69. (%gsavepagedevice) cvn
  70.  { currentpagedevice pop gsave
  71.  } bind def
  72.  
  73. (%savepagedevice) cvn
  74.  { currentpagedevice pop save
  75.  } bind def
  76.  
  77. (%gstatepagedevice) cvn
  78.  { currentpagedevice pop gstate
  79.  } bind def
  80.  
  81. (%copygstatepagedevice) cvn
  82.  { currentpagedevice pop copy
  83.  } bind def
  84.  
  85. (%currentgstatepagedevice) cvn
  86.  { currentpagedevice pop currentgstate
  87.  } bind def
  88.  
  89. % Define interpreter callouts for handling gstate-restoring operators
  90. % when the current page device needs to be changed.
  91. % The names %grestorepagedevice, %grestoreallpagedevice,
  92. % %restorepagedevice, %restore1pagedevice, and %setgstatepagedevice
  93. % are known to the interpreter.
  94.  
  95. /.installpagedevice
  96.  {    % Since setpagedevice doesn't create new device objects,
  97.     % we must (carefully) reinstall the old parameters in
  98.     % the same device.
  99.    .currentpagedevice pop null currentdevice null .trysetparams
  100.    dup type /booleantype eq
  101.     { pop pop }
  102.     {        % This should never happen!
  103.       DEBUG { (Error in .trysetparams!) = pstack flush } if
  104.       cleartomark pop pop pop
  105.       /.installpagedevice cvx /rangecheck signalerror
  106.     }
  107.    ifelse pop pop
  108.     % A careful reading of the Red Book reveals that an erasepage
  109.     % should occur, but *not* an initgraphics.
  110.    erasepage .beginpage
  111.  } bind def
  112.  
  113. /.uninstallpagedevice
  114.  { 2 .endpage { .currentnumcopies false .outputpage } if
  115.    nulldevice
  116.  } bind def
  117.  
  118. (%grestorepagedevice) cvn
  119.  { .uninstallpagedevice grestore .installpagedevice
  120.  } bind def
  121.  
  122. (%grestoreallpagedevice) cvn
  123.  { .uninstallpagedevice grestore .installpagedevice grestoreall
  124.  } bind def
  125.  
  126. (%restore1pagedevice) cvn
  127.  { .uninstallpagedevice grestore .installpagedevice restore
  128.  } bind def
  129.  
  130. (%restorepagedevice) cvn
  131.  { .uninstallpagedevice restore .installpagedevice
  132.  } bind def
  133.  
  134. (%setgstatepagedevice) cvn
  135.  { .uninstallpagedevice setgstate .installpagedevice
  136.  } bind def
  137.  
  138. % Redefine .currentnumcopies so it consults the NumCopies device parameter.
  139. /.numcopiesdict mark
  140.   /NumCopies dup
  141. .dicttomark readonly def
  142.  
  143. /.currentnumcopies
  144.  { currentdevice //.numcopiesdict .getdeviceparams
  145.    dup type /integertype eq
  146.     { exch pop exch pop }
  147.     { cleartomark #copies }
  148.    ifelse
  149.  } bind odef
  150.  
  151. % Redefine .currentpagedevice and .setpagedevice so they convert between
  152. % null and a fixed empty directionary.
  153. /.nullpagedevice 0 dict readonly def
  154. /.currentpagedevice {
  155.   //.currentpagedevice exch dup null eq { pop //.nullpagedevice } if exch
  156. } bind odef
  157. /.setpagedevice {
  158.   dup //.nullpagedevice eq { pop null } if //.setpagedevice
  159. } bind odef
  160.  
  161. % ---------------- Auxiliary definitions ---------------- %
  162.  
  163. % Define the required attributes of all page devices, and their default values.
  164. % We don't include attributes such as .MediaSize, which all devices
  165. % are guaranteed to supply on their own.
  166. /.defaultpolicies mark
  167.   /PolicyNotFound 1
  168.   /PageSize 0
  169.   /PolicyReport {
  170.     dup /.LockSafetyParams known {
  171.     % Only possible error is invalidaccess
  172.       /setpagedevice .systemvar /invalidaccess signalerror
  173.     }
  174.     if
  175.     pop
  176.   } bind
  177. .dicttomark readonly def
  178. % Note that the values of .requiredattrs are executed, not just fetched.
  179. /.requiredattrs mark
  180.   /PageDeviceName null
  181.   /PageOffset [0 0] readonly
  182. % We define InputAttributes and OutputAttributes with a single
  183. % dummy media type that handles pages of any size.
  184. % Devices that care will override this.
  185.   /InputAttributes {
  186.     mark 0
  187.     % Since sizes match within 5 user units, we need to set the smallest
  188.     % PageSize to 6 units so that [0 0] will fail.
  189.     mark /PageSize [6 dup 16#7ffff dup] .dicttomark
  190.     .dicttomark
  191.   }
  192.   (%MediaSource) 0
  193.   /OutputAttributes {
  194.     mark 0 mark .dicttomark readonly .dicttomark
  195.   }
  196.   (%MediaDestination) 0
  197.   /Install {{.callinstall}} bind
  198.   /BeginPage {{.callbeginpage}} bind
  199.   /EndPage {{.callendpage}} bind
  200.   /Policies .defaultpolicies
  201. .dicttomark readonly def
  202.  
  203. % Define currentpagedevice so it creates the dictionary on demand if needed,
  204. % adding all the required entries defined just above.
  205. % We have to deal specially with entries that the driver may change
  206. % on its own.
  207. /.dynamicppkeys mark
  208.   /.MediaSize dup        % because it changes when PageSize is set
  209.   /PageCount dup
  210. .dicttomark readonly def
  211. /.makecurrentpagedevice {    % - .makecurrentpagedevice <dict>
  212.   currentdevice null .getdeviceparams
  213.     % Make the dictionary large enough to add defaulted entries.
  214.   counttomark 2 idiv .requiredattrs length add dict
  215.   counttomark 2 idiv { dup 4 2 roll put } repeat exch pop
  216.     % Add any missing required attributes.
  217.     % Make a writable and (if possible) local copy of any default
  218.     % dictionaries, to work around a bug in the output of WordPerfect,
  219.     % which assumes that these dictionaries are writable and local.
  220.   .currentglobal exch dup gcheck .setglobal
  221.   .requiredattrs {
  222.     2 index 2 index known {
  223.       pop pop
  224.     } {
  225.       exec 2 index 3 1 roll put
  226.     } ifelse
  227.   } forall exch .setglobal
  228.   dup .setpagedevice
  229. } bind def
  230. /currentpagedevice {
  231.   .currentpagedevice {
  232.     dup length 0 eq {
  233.       pop .makecurrentpagedevice
  234.     } {
  235.         % If any of the dynamic keys have changed,
  236.         % we must update the page device dictionary.
  237.       currentdevice //.dynamicppkeys .getdeviceparams .dicttomark {
  238.         % Stack: current key value
  239.         2 index 2 index .knownget { 1 index ne } { true } ifelse
  240.          { 2 index wcheck not
  241.         {    % This is the first entry being updated.
  242.             % Copy the dictionary to make it writable.
  243.           3 -1 roll
  244.           currentglobal 1 index dup gcheck currentglobal and setglobal
  245.           length dict exch setglobal .copydict
  246.           3 1 roll
  247.         }
  248.            if
  249.            2 index 3 1 roll put
  250.          }
  251.          { pop pop
  252.          }
  253.         ifelse
  254.       } forall
  255.         % If the dictionary was global and is now local, copy
  256.         % any global subsidiary dictionaries to local VM.  This
  257.         % too is to work around the Word Perfect bug (see above).
  258.       dup gcheck not {
  259.     dup {
  260.       dup type /dicttype eq { dup gcheck } { false } ifelse {
  261.         % Copy-on-write, see above.
  262.         2 index wcheck not {
  263.           3 -1 roll dup length dict .copydict
  264.           3 1 roll
  265.         } if
  266.         .copytree 2 index 3 1 roll put
  267.       } {
  268.         pop pop
  269.       } ifelse
  270.     } forall
  271.       } if
  272.         % We would like to do a .setpagedevice so we don't keep
  273.         % re-creating the dictionary.  Unfortunately, the effect
  274.         % of this is that if any dynamic key changes (PageCount
  275.         % in particular), we will do the equivalent of a
  276.         % setpagedevice at the next restore or grestore.
  277.         % Therefore, we make the dictionary read-only, but
  278.         % we don't store it away.  I.e., NOT:
  279.         % dup wcheck { .setpagedevice .currentpagedevice pop } if
  280.       readonly
  281.     } ifelse
  282.   } if
  283. } bind odef
  284.  
  285. % Copy a dictionary recursively.
  286. /.copytree {    % <dict> .copytree <dict'>
  287.   dup length dict exch {
  288.     dup type /dicttype eq { .copytree } if 2 index 3 1 roll put
  289.   } forall
  290. } bind def
  291.  
  292. % The implementation of setpagedevice is quite complex.  Currently,
  293. % everything but the media matching algorithm is implemented here.
  294.  
  295. % By default, we only present the requested changes to the device,
  296. % but there are some parameters that require special merging action.
  297. % Define those parameters here, with the procedures that do the merging.
  298. % The procedures are called as follows:
  299. %    <merged> <key> <new_value> -proc- <merged> <key> <new_value'>
  300. /.mergespecial mark
  301.   /InputAttributes
  302.    { dup null eq
  303.       { pop null
  304.       }
  305.       { 3 copy pop .knownget
  306.      { dup null eq
  307.         { pop dup length dict }
  308.         { dup length 2 index length add dict .copydict }
  309.        ifelse
  310.      }
  311.      { dup length dict
  312.      }
  313.         ifelse .copydict readonly
  314.       }
  315.      ifelse
  316.    } bind
  317.   /OutputAttributes 1 index
  318.   /Policies
  319.     { 3 copy pop .knownget
  320.        { dup length 2 index length add dict .copydict }
  321.        { dup length dict }
  322.       ifelse copy readonly
  323.     } bind
  324. .dicttomark readonly def
  325.  
  326. % Define the keys used in input attribute matching.
  327. /.inputattrkeys [
  328.   /PageSize /MediaColor /MediaWeight /MediaType /InsertSheet
  329.     % The following are documented in Adobe's supplement for v2017.
  330.   /LeadingEdge /MediaClass
  331. ] readonly def
  332. % Define other keys used in media selection.
  333. /.inputselectionkeys [
  334.   /MediaPosition /Orientation
  335. ] readonly def
  336.  
  337. % Define the keys used in output attribute matching.
  338. /.outputattrkeys [
  339.   /OutputType
  340. ] readonly def
  341.  
  342. % Define all the parameters that should always be copied to the merged
  343. % dictionary.
  344. /.copiedkeys [
  345.   /OutputDevice
  346.   .mergespecial { pop } forall
  347.   .inputattrkeys aload pop
  348.   .inputselectionkeys aload pop
  349.   .outputattrkeys aload pop
  350. ] readonly def
  351.  
  352. % Define the parameters that should not be presented to the device.
  353. % The procedures are called as follows:
  354. %    <merged> <key> <value> -proc-
  355. % The procedure leaves all its operands on the stack and returns
  356. % true iff the key/value pair should be presented to .putdeviceparams.
  357. /.presentspecial mark
  358.   .dynamicppkeys { pop false } forall
  359.             % We must ignore an explicit request for .MediaSize,
  360.             % because media matching always handles this.
  361.   /.MediaSize false
  362.   /Name false
  363.   /OutputDevice false
  364.   /PageDeviceName false
  365.   /PageOffset false
  366.   /PageSize false        % obsolete alias for .MediaSize
  367.   /InputAttributes false
  368.   .inputattrkeys
  369.     { dup /PageSize eq
  370.        { pop }
  371.        { { 2 index /InputAttributes .knownget { null eq } { true } ifelse } }
  372.       ifelse
  373.     }
  374.   forall
  375.   .inputselectionkeys { false } forall
  376.   /OutputAttributes false
  377.   .outputattrkeys
  378.     { { 2 index /OutputAttributes .knownget { null eq } { true } ifelse } }
  379.   forall
  380.   /Install false
  381.   /BeginPage false
  382.   /EndPage false
  383.   /Policies false
  384.     % Our extensions:
  385.   /HWColorMap
  386.     {            % HACK: don't transmit the color map, because
  387.             % window systems can change the color map on their own
  388.             % incrementally.  Someday we'll have a better
  389.             % solution for this....
  390.       false
  391.     }
  392.   /ViewerPreProcess false
  393. .dicttomark readonly def
  394.  
  395. % Define access to device defaults.
  396. /.defaultdeviceparams
  397.  { finddevice null .getdeviceparams
  398.  } bind def
  399.  
  400. % Select media (input or output).  The hard work is done in an operator:
  401. %    <pagedict> <attrdict> <policydict> <keys> .matchmedia <key> true
  402. %    <pagedict> <attrdict> <policydict> <keys> .matchmedia false
  403. %    <pagedict> null <policydict> <keys> .matchmedia null true
  404. /.selectmedia        % <orig> <request> <merged> <failed>     <-- retained
  405.             %   <attrdict> <policydict> <attrkeys> <mediakey>
  406.             %   .selectmedia
  407.  { 5 index 5 -2 roll 4 index .matchmedia
  408.         % Stack: orig request merged failed attrkeys mediakey
  409.         %   (key true | false)
  410.     { 4 index 3 1 roll put pop
  411.     }
  412.     {    % Adobe's implementations have a "big hairy heuristic"
  413.     % to choose the set of keys to report as having failed the match.
  414.     % For the moment, we report any keys that are in the request
  415.     % and don't have the same value as in the original dictionary.
  416.       5 index 1 index .knownget
  417.        { 4 index 3 1 roll put }
  418.        { 3 index exch .undef }
  419.       ifelse
  420.        {    % Stack: <orig> <request> <merged> <failed> <attrkey>
  421.      3 index 1 index .knownget
  422.       { 5 index 2 index .knownget { ne } { pop true } ifelse }
  423.       { true }
  424.      ifelse        % Stack: ... <failed> <attrkey> <report>
  425.       { 2 copy /rangecheck put }
  426.      if pop
  427.        }
  428.       forall
  429.     }
  430.    ifelse
  431.  } bind def
  432.  
  433. % Apply Policies to any unprocessed failed requests.
  434. % As we process each request entry, we replace the error name
  435. % in the <failed> dictionary with the policy value,
  436. % and we replace the key in the <merged> dictionary with its prior value
  437. % (or remove it if it had no prior value).
  438. /.policyprocs mark
  439. % These procedures are called with the following on the stack:
  440. %   <orig> <merged> <failed> <Policies> <key> <policy>
  441. % They are expected to consume the top 2 operands.
  442. % NOTE: we currently treat all values other than 0, 1, or 7 (for PageSize)
  443. % the same as 0, i.e., we signal an error.
  444.   0 {        % Set errorinfo and signal a configurationerror.
  445.     pop dup 4 index exch get 2 array astore
  446.     $error /errorinfo 3 -1 roll put
  447.     cleartomark
  448.     /setpagedevice load /configurationerror signalerror
  449.   } bind
  450.   1 {        % Roll back the failed request to its previous status.
  451. DEBUG { (Rolling back.) = pstack flush } if
  452.     3 index 2 index 3 -1 roll put
  453.     4 index 1 index .knownget
  454.      { 4 index 3 1 roll put }
  455.      { 3 index exch .undef }
  456.     ifelse
  457.   } bind
  458.   7 {        % For PageSize only, just impose the request.
  459.     1 index /PageSize eq
  460.      { pop pop 1 index /PageSize 7 put }
  461.      { .policyprocs 0 get exec }
  462.     ifelse
  463.   } bind
  464. .dicttomark readonly def
  465. /.applypolicies        % <orig> <merged> <failed> .applypolicies
  466.             %   <orig> <merged'> <failed'>
  467.  { 1 index /Policies get 1 index
  468.     { type /integertype eq
  469.        { pop        % already processed
  470.        }
  471.        { 2 copy .knownget not { 1 index /PolicyNotFound get } if
  472.             % Stack: <orig> <merged> <failed> <Policies> <key>
  473.             %   <policy>
  474.      .policyprocs 1 index .knownget not { .policyprocs 0 get } if exec
  475.        }
  476.       ifelse
  477.     }
  478.    forall pop
  479.  } bind def
  480.  
  481. % Prepare to present parameters to the device, by spreading them onto the
  482. % operand stack and removing any that shouldn't be presented.
  483. /.prepareparams        % <params> .prepareparams -mark- <key1> <value1> ...
  484.  { mark exch dup
  485.     {            % Stack: -mark- key1 value1 ... merged key value
  486.       .presentspecial 2 index .knownget
  487.        { exec { 3 -1 roll } { pop pop } ifelse }
  488.        { 3 -1 roll }
  489.       ifelse
  490.     }
  491.    forall pop
  492.  } bind def
  493.  
  494. % Put device parameters without resetting currentpagedevice.
  495. % (.putdeviceparams clears the current page device.)
  496. /.putdeviceparamsonly    % <device> <Policies|null> <require_all> -mark-
  497.             %   <key1> <value1> ... .putdeviceparamsonly
  498.             % On success: <device> <eraseflag>
  499.             % On failure: <device> <Policies|null> <req_all> -mark-
  500.             %   <key1> <error1> ...
  501.  { .currentpagedevice
  502.     { counttomark 4 add 1 roll .putdeviceparams
  503.       dup type /booleantype eq { 3 } { counttomark 5 add } ifelse -1 roll
  504.       .setpagedevice
  505.     }
  506.     { pop .putdeviceparams
  507.     }
  508.    ifelse
  509.  } bind def
  510.  
  511. % Try setting the device parameters from the merged request.
  512. /.trysetparams        % <merged> <(ignored)> <device> <Policies>
  513.             %   .trysetparams
  514.  { true 4 index .prepareparams
  515.             % Add the computed .MediaSize.
  516.             % Stack: merged (ignored) device Policies -true-
  517.             %   -mark- key1 value1 ...
  518.    counttomark 5 add index .computemediasize
  519.    exch pop exch pop /.MediaSize exch
  520. DEBUG { (Putting.) = pstack flush } if
  521.    .putdeviceparamsonly
  522. DEBUG { (Result of putting.) = pstack flush } if
  523.  } bind def
  524.  
  525. % Compute the media size and initial matrix from a merged request (after
  526. % media selection).
  527. /.computemediasize    % <request> .computemediasize
  528.             %   <request> <matrix> <[width height]>
  529.  { dup /PageSize get                    % requested page size
  530.    1 index /InputAttributes get
  531.      2 index (%MediaSource) get get /PageSize get    % media size
  532.                             % (may be a range)
  533.    2 index /Policies get
  534.      dup /PageSize .knownget
  535.       { exch pop } { /PolicyNotFound get } ifelse    % PageSize policy,
  536.                             % affects scaling
  537.    3 index /Orientation .knownget not { null } if
  538.    4 index /RollFedMedia .knownget not { false } if
  539.    matrix .matchpagesize not {
  540.         % This is a "can't happen" condition!
  541.      /setpagedevice load /rangecheck signalerror
  542.    } if
  543.    2 array astore
  544.  } bind def
  545.  
  546. % ---------------- setpagedevice itself ---------------- %
  547.  
  548. /setpagedevice
  549.  {        % We mustn't pop the argument until the very end,
  550.         % so that the pseudo-operator machinery can restore the stack
  551.         % if an error occurs.
  552.    mark 1 index currentpagedevice
  553.  
  554.         % Check whether we are changing OutputDevice;
  555.         % also handle the case where the current device
  556.         % is not a page device.
  557.         % Stack: mark <request> <current>
  558. DEBUG { (Checking.) = pstack flush } if
  559.  
  560.    dup /OutputDevice .knownget
  561.     {        % Current device is a page device.
  562.       2 index /OutputDevice .knownget
  563.        {    % A specific OutputDevice was requested.
  564.      2 copy eq
  565.       { pop pop null }
  566.       { exch pop }
  567.      ifelse
  568.        }
  569.        { pop null
  570.        }
  571.       ifelse
  572.     }
  573.     {        % Current device is not a page device.
  574.         % Use the default device.
  575.       1 index /OutputDevice .knownget not { .defaultdevicename } if
  576.     }
  577.    ifelse
  578.    dup null eq
  579.     { pop
  580.     }
  581.     { exch pop .defaultdeviceparams
  582.         % In case of duplicate keys, .dicttomark takes the entry
  583.         % lower on the stack, so we can just append the defaults here.
  584.       .requiredattrs { exec } forall .dicttomark
  585.     }
  586.    ifelse
  587.  
  588.         % Check whether a viewer wants to intervene.
  589.         % We must check both the request (which takes precedence)
  590.         % and the current dictionary.
  591.         % Stack: mark <request> <orig>
  592.    exch dup /ViewerPreProcess .knownget
  593.     { exec }
  594.     { 1 index /ViewerPreProcess .knownget { exec } if }
  595.    ifelse exch
  596.  
  597.         % Construct a merged request from the actual request plus
  598.         % any keys that should always be propagated.
  599.         % Stack: mark <request> <orig>
  600. DEBUG { (Merging.) = pstack flush } if
  601.  
  602.    exch 1 index length 1 index length add dict
  603.    .copiedkeys
  604.     {        % Stack: <orig> <request> <merged> <key>
  605.       3 index 1 index .knownget { 3 copy put pop } if pop
  606.     }
  607.    forall
  608.         % Stack: <orig> <request> <merged>
  609.    dup 2 index
  610.     {        % stack: <orig> <request> <merged> <merged> <rkey> <rvalue>
  611.       .mergespecial 2 index .knownget { exec } if
  612.       put dup
  613.     }
  614.    forall pop
  615.         % Hack: if FIXEDRESOLUTION is true, discard any attempt to
  616.         % change HWResolution.
  617.    FIXEDRESOLUTION { dup /HWResolution .undef } if
  618.         % Hack: if FIXEDMEDIA is true, discard any attempt to change
  619.         % PageSize or HWSize.
  620.    FIXEDMEDIA
  621.     { dup /PageSize 4 index /PageSize get put
  622.       dup /HWSize 4 index /HWSize get put
  623.     } if
  624.         % Hack: to work around some files that take a PageSize
  625.         % from InputAttributes and impose it, discard any attempt
  626.         % to set PageSize to a 4-element value.
  627.         % Stack: mark <orig> <request> <merged>
  628.     dup /PageSize .knownget {
  629.       length 2 ne {
  630.     dup /PageSize 4 index /PageSize get put
  631.       } if
  632.     } if
  633.  
  634.         % Select input and output media.
  635.         % Stack: mark <orig> <request> <merged>
  636. DEBUG { (Selecting.) = pstack flush } if
  637.  
  638.    0 dict    % <failed>
  639.    1 index /InputAttributes .knownget
  640.     { 2 index /Policies get
  641.       .inputattrkeys (%MediaSource) cvn .selectmedia
  642.     } if
  643.    1 index /OutputAttributes .knownget
  644.     { 2 index /Policies get
  645.       .outputattrkeys (%MediaDestination) cvn .selectmedia
  646.      } if
  647.    3 -1 roll 4 1 roll        % temporarily swap orig & request
  648.    .applypolicies
  649.    3 -1 roll 4 1 roll        % swap back
  650.  
  651.         % Construct the new device, and attempt to set its attributes.
  652.         % Stack: mark <orig> <request> <merged> <failed>
  653. DEBUG { (Constructing.) = pstack flush } if
  654.  
  655.    currentdevice .devicename 2 index /OutputDevice get eq
  656.     { currentdevice }
  657.     { 1 index /OutputDevice get finddevice }
  658.    ifelse
  659.         %**************** We should copy the device here,
  660.         %**************** but since we can't close the old device,
  661.         %**************** we don't.  This is WRONG.
  662.     %****************copydevice
  663.    2 index /Policies get
  664.    .trysetparams
  665.    dup type /booleantype ne
  666.     {        % The request failed.
  667.         % Stack: ... <orig> <request> <merged> <failed> <device>
  668.         %   <Policies> true mark <name> <errorname> ...
  669. DEBUG { (Recovering.) = pstack flush } if
  670.       counttomark 4 add index
  671.       counttomark 2 idiv { dup 4 -2 roll put } repeat
  672.       pop pop pop
  673.         % Stack: mark ... <orig> <request> <merged> <failed> <device>
  674.         %   <Policies>
  675.       6 2 roll 3 -1 roll 4 1 roll
  676.       .applypolicies
  677.       3 -1 roll 4 1 roll 6 -2 roll
  678.       .trysetparams        % shouldn't fail!
  679.       dup type /booleantype ne
  680.        { 2 { counttomark 1 add 1 roll cleartomark } repeat
  681.          /setpagedevice load exch signalerror
  682.        }
  683.       if
  684.     }
  685.    if
  686.  
  687.         % The attempt succeeded.  Install the new device.
  688.         % Stack: mark ... <merged> <failed> <device> <eraseflag>
  689. DEBUG { (Installing.) = pstack flush } if
  690.  
  691.    pop 2 .endpage
  692.     { 1 true .outputpage
  693.       (>>setpagedevice, press <return> to continue<<\n) .confirm
  694.     }
  695.    if
  696.         % .setdevice clears the current page device!
  697.    .currentpagedevice pop exch
  698.    .setdevice pop
  699.    .setpagedevice
  700.  
  701.         % Merge the request into the current page device,
  702.         % unless we're changing the OutputDevice.
  703.         % Stack: mark ... <merged> <failed>
  704.    exch currentpagedevice dup length 2 index length add dict
  705.         % Stack: mark ... <failed> <merged> <current> <newdict>
  706.    2 index /OutputDevice .knownget {
  707.      2 index /OutputDevice .knownget not { null } if eq
  708.    } {
  709.      true
  710.    } ifelse {
  711.         % Same OutputDevice, merge the dictionaries.
  712.      .copydict
  713.    } {
  714.         % Different OutputDevice, discard the old dictionary.
  715.      exch pop
  716.    } ifelse .copydict
  717.         % Initialize the default matrix, taking media matching
  718.         % into account.
  719.    .computemediasize pop initmatrix concat
  720.    dup /PageOffset .knownget
  721.     {        % Translate by the given number of 1/72" units in device X/Y.
  722.       dup 0 get exch 1 get
  723.       2 index /HWResolution get dup 1 get exch 0 get
  724.       4 -1 roll mul 72 div   3 1 roll mul 72 div
  725.       idtransform translate
  726.     }
  727.    if
  728.         % We must install the new page device dictionary
  729.         % before calling the Install procedure.
  730.   dup .setpagedevice
  731.   .setdefaultscreen    % Set the default screen before calling Install.
  732.   dup /Install .knownget {
  733.     { .execinstall } stopped { .postinstall stop } { .postinstall } ifelse
  734.   } {
  735.     .postinstall
  736.   } ifelse
  737. } odef
  738.  
  739. % We break out the code after calling the Install procedure into a
  740. % separate procedure, since it is executed even if Install causes an error.
  741. % By making .execinstall a separate operator procedure, we get the stacks
  742. % restored if it fails.
  743.  
  744. /.execinstall {        % <proc> .execinstall -
  745.     % Because the interpreter optimizes tail calls, we can't just let
  746.     % the body of this procedure be 'exec', because that would lose
  747.     % the stack protection that is the whole reason for having the
  748.     % procedure in the first place.  We hack this by adding a couple
  749.     % of extra tokens to ensure that the operator procedure is still
  750.     % on the stack during the exec.
  751.   exec
  752.   0 pop    % See above.
  753. } odef
  754. /.postinstall {        % mark ... <failed> <merged> .postinstall -
  755.    matrix currentmatrix .setdefaultmatrix
  756.         % Erase and initialize the page.
  757.    erasepage initgraphics
  758.    .beginpage
  759.  
  760.         % Clean up, calling PolicyReport if needed.
  761.         % Stack: mark ... <failed> <merged>
  762. DEBUG { (Finishing.) = pstack flush } if
  763.  
  764.    exch dup length 0 ne
  765.     { 1 index /Policies get /PolicyReport get
  766.       counttomark 1 add 2 roll cleartomark
  767.       exec
  768.     }
  769.     { cleartomark
  770.     }
  771.    ifelse pop
  772.  
  773. } odef
  774.  
  775. end                % level2dict
  776. .setlanguagelevel
  777.